Amiga Plus Special 17/AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso/Rexx/SaveNets.AmiCAD

Text File | 1998-08-08 | 9KB | 369 lines

/* Élaboration d'une netlist */
/* $VER: SaveNets 1.0 (© R.Florac, 14-07-98) */
/* Ne teste que les lignes horizontales ou verticales (pour les intersections) */

options results     /* indispensable pour récupérer le résultat des macros */

signal on error     /* pour l'interception des erreurs */
signal on syntax

/* Test des liaisons */
j=1; nets=1;
'DEF NEXTJUNCTION(O)=OO=O:WHILE(IF(OO>0,TYPE(OO)<>7,0),IF(OO<OBJECTS(-1),OO=OO+1,OO=0)):OO'
'UNMARK(-1):LOCK(-1):OBJECTS(-1)'; objets=result
/* Tableaux de données:
equi: une donnée par élément, donne l'indice de l'équipotentielle à laquelle est liée une ligne
label: une donnée par équipotentielle, donne son nom */
equi.=-1
label.=""

'TITLE("Lecture des labels...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
    'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
    if j>0 then do
        'READTEXT(O)'; label=result
        if datatype(label,"w") then do      /* signale les labels numériques existants */
        label.label="LABEL_DÉJÀ_UTILISÉ"
        end
    end
    end
end

'TITLE("Analyse des liaisons...")'
i=1
do while i>0
    'OO=FINDOBJ('i',2,-1,-1)'; i=result
    if result>0 then do
    'TEST(OO)'
    if result=0 then do
        do while label.nets~=""
        nets=nets+1
        end
        label.nets=nets
        equi.i=nets
        'COORDS(OO)'            /* Marquage du fil */
        parse var result x0','y0','x1','y1
        call test_ligne(x0,y0,nets,objets)
        call test_ligne(x1,y1,nets,objets)
    end
    if i=objets then i=0
    else i=i+1
    end
end

'TITLE("Analyse des jonctions...")'
i=1
do while i>0
    'I=FINDOBJ('i',7,-1,-1)'; i=result
    if i>0 then do
    'MARK(I):L1=ABS(FINDLINE(1,COL(I),LINE(I)))'; l1=result
    if l1>0 & l1<objets then do
        j=l1+1
        do while j>0
        'J=ABS(FINDLINE('j',COL(I),LINE(I)))'; j=result
        if j>0 then do
            if equi.j~=equi.l1 then do
            call changer_labels(l1,j)
            end
            if j=objets then j=0
            else j=j+1
        end
        end
    end
    if i=objets then i=0
    else i=i+1
    end
end

'TITLE("Recherche des labels et des connecteurs...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
    'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
    if j>0 then do
        net=equi.j
        'READTEXT(O)'; label=result
        label.net=label
    end
    end
end

'TITLE("Recherche des alimentations...")'
do i=1 to objets
    'FINDPART('i',"ALIMENTATION")'; i=result
    if i>0 then do
    j=connexion_broche(i,1)
    if j>0 then do
        net=equi.j
        'READTEXT(GETVAL('i'))'; label=result
        label.net=label
    end
    end
    else leave
end

'TITLE("Test redondances...")'
do i=1 to nets
    do j=i+1 to nets
    if label.j~="" then do
        if label.i=label.j then do
        do k=1 to objets
            if equi.k=j then equi.k=i
        end
        label.j=""
        end
    end
    end
end

'TITLE("Recherche des masses...")'
do i=1 to objets
    'FINDPART('i',"MASSE")'; i=result
    if i>0 then do
    j=connexion_broche(i,1)
    if j>0 then do
        equi.0=0; label.0=0
        call changer_labels(0,j)
    end
    end
    else leave
end

do until c=0
    'TITLE("Établissement équipotentielles terminé"):SELECT("Choisissez une action"+CHR(10)+"Visualiser les équipotentielles"+CHR(10)+"Contrôler la netlist"+CHR(10)+"Sauver la netlist"+CHR(10)+"Abandonner ce script")'
    select
    when result=1 then call visu_equi
    when result=2 then call controler_netlist
    when result=3 then call sauver_netlist
    otherwise c=0
    end
end
exit

visu_equi:
    'TITLE("Vérification équipotentielles"):UNMARK(-1)'
    do i=0 to nets
    if label.i ~= "LABEL_DÉJÀ_UTILISÉ" & label.i ~= "" then do
        do j=1 to objets
        if equi.j=i then 'MARK('j')'
        end
        'SELECT("Équipotentielle 'label.i'"+CHR(10)+"Abandonner"+CHR(10)+"Continuer"+CHR(10)+"Sauver netlist"+CHR(10)+"Contrôler netlist")'
        if result <= 1 then return
        if result = 3 then do
        call sauver_netlist
        exit
        end
        if result = 4 then do
        call controler_netlist
        leave
        end
        'UNMARK(-1)'
    end
    end
    return

test_ligne: procedure expose equi.
    parse arg x0,y0,n,nbo
    o=1
    do until o=0
    'X=FINDOBJ('o',2,'x0','y0')'; o=result
    if o>0 then do
        'IF(TEST(X),"",MARK(X):COORDS(X))'
        if result~="" then do
        parse var result x1','y1','x2','y2
        equi.o=n
        if x0=x1 & y0=y1 then call test_ligne(x2,y2,n,nbo)
        else call test_ligne(x1,y1,n,nbo)
        end
        if o=nbo then o=0
        else o=o+1
    end
    end
    return

changer_labels: procedure expose equi. objets label.
    parse arg o1,o2
    if datatype(equi.o2,'w') then do
    e=equi.o2
    label.e=""
    do i=1 to objets
        if equi.i=e then equi.i=equi.o1
    end
    return o1
    end
    else do
    e=equi.o1
    label.e=""
    do i=1 to objets
        if equi.i=e then equi.i=equi.o2
    end
    return o2
    end
    return

test_jonction: procedure expose equi.
    parse arg xj,yj,n,objets
    obj=1
    do while obj>0
    'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
    if obj>0 then do
        if equi.obj=n then return 1
        if obj=objets then return 0
        obj=obj+1
    end
    end
    return 0

controler_netlist:
    'TITLE("Contrôle netlist...")'
    i=1
    do while i>0
    'O=FINDOBJ('i',1,-1,-1)'; i=result
    if i>0 then do
        'PARTNAME(O)'
        if result~="ALIMENTATION" & result ~="MASSE" then do
        'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
        ligne=translate(result,"_"," ")||' '
        'DEVPINS(O)'; j=result
        do k=1 to j
            l=connexion_broche(i,k)
            if l>0 then do
            net=equi.l
            ligne=ligne||label.net||' '
            end
            else ligne=ligne||"-1"||' '
        end
        'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
        ligne=ligne||result
        'UNMARK(-1):MARK(O):SELECT("'ligne'"+CHR(10)+"Continuer"+CHR(10)+"Abandonner")'
        if result~=1 then return
        end
        if i=objets then leave
        i=i+1
    end
    end
    'TITLE("")'
return

sauver_netlist:
    'TITLE(""):REQFILE("Fichier netlist à créer","Spice")'
    fichier=result
    if fichier="" then return
    'TITLE("Sauvegarde netlist...")'
    if ~open(file, fichier, 'W') then return
    'FILEPART("")'
    writeln(file,result)
    'DATE(1)+" à "+TIME(1)'
    writeln(file,"* Créé par AmiCAD, le "||result||" *")
    do i=1 to objets
    'O=FINDOBJ('i',1,-1,-1)'; i=result
    if result>0 then do
        'PARTNAME(O)'
        if result~="ALIMENTATION" & result ~="MASSE" then do
        'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
        ligne=translate(result,"_"," ")||' '
        'DEVPINS(O)'; j=result
        do k=1 to j
            l=connexion_broche(i,k)
            if l>0 then do
            net=equi.l
            ligne=ligne||label.net||' '
            end
            else ligne=ligne||"-1"||' '
        end
        'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
        ligne=ligne||result
        call writeln(file, ligne)
        end
    end
    else leave i
    end
    analyse=""
    do i=1 to objets
    'FINDOBJ('i',4,-1,-1)'; i=result
    if i>0 then do
        'READTEXT('i')'; t=result
        if left(t,10)=".ANALYSE: " then do
        analyse=right(t,length(t)-10)
        end
    end
    else leave
    end
    if analyse="" then do
    'SELECT("Type d''analyse à effectuer"+CHR(10)+"AC"+CHR(10)+"DC"+CHR(10)+"Transient")'
    select
        when result=1 then do
        'SELECT("Type de variation"+CHR(10)+"Décade"+CHR(10)+"Octave"+CHR(10)+"Linéaire")'
        select
            when result=1 then do
            f="DEC "; v="par décade"
            end
            when result=2 then do
            f="OCT "; v="par octave"
            end
            when result=3 then do
            f="LIN "; v="de test"
            end
            otherwise do
            close(file)
            return
            end
        end
        'ASK("Nombre de points 'v'?")'
        f=f||result
        'ASK("Quelle est la fréquence de début?")'
        f=f||" "||result
        'ASK("Quelle est la fréquence de fin?")'
        analyse="AC "||f||' '||result
        end
        when result=2 then do
        'ASK("Quel est le nom du générateur à faire varier.")'
        f=result
        'ASK("Quelle est la valeur de départ?")'
        f=f||' '||result
        'ASK("Quelle est la valeur finale.")'
        f=f||' '||result
        'ASK("Quel est l''incrément?")'
        analyse="DC "||f||' '||result
        end
        when result=3 then do
        'ASK("Temps de simulation?")'; temps=result
        'ASK("Pas de simulation?")'; pas=result
        'ASK("Temps de début de la simulation?")'; d=result
        analyse="tran "||pas||" "||temps||" "||d
        end
        otherwise
        return
    end
    end
    if analyse~="" then writeln(file,"."||analyse)
    writeln(file,".END")
    close(file)
    'MESSAGE("Sauvegarde terminée")'
    'TITLE("")'
return

connexion_broche: procedure
    parse arg objet,broche
    'PINCOL(O='objet',B='broche')'; xj=result
    'PINLINE(O,B)'; yj=result
    'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
    if xl>0 then return xl
    'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe sur la broche... */
    if xl<=0 then return 0
    'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
    if result>0 then return xl
    return 0

/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Script SaveNets.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
'MESSAGE("Script SaveNets.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
exit